home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1996-02-14 | 4.1 KB | 108 lines |
- Syntax10.Scn.Fnt
- ParcElems
- Alloc
- Syntax24b.Scn.Fnt
- StampElems
- Alloc
- 14 Feb 96
- Syntax10b.Scn.Fnt
- Syntax10i.Scn.Fnt
- (* AMIGA *)
- MODULE Display1; (* RC 11.12.92, cn
- IMPORT
- SYSTEM, Amiga,Display,Pictures;
- CONST
- white = 0; grey1 = 1; grey2 = 2; grey3 = 3; grey4 = 4; black = 5;
- texture0 = 6; texture1 = 7; texture2 = 8; texture3 = 9;
- scrPat: ARRAY 10 OF LONGINT;
- PROCEDURE GetPatternSize*(pat: Display.Pattern; VAR w, h: INTEGER);
- (* Returns the pattern size. *)
- VAR p: Amiga.PatternInfoPtr;
- BEGIN p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat); w := p.w; h := p.h
- END GetPatternSize;
- PROCEDURE ThisPattern*(n: INTEGER): Display.Pattern;
- (* Returns the n-th predefined pattern (corresponding to the printer patterns). If the pattern is not available,
- 0 is returned. n must be >= 0. Currently 10 patterns are predefined (0 .. 9). *)
- BEGIN
- IF n >= LEN(scrPat) THEN RETURN 0
- ELSE RETURN scrPat[n]
- END
- END ThisPattern;
- PROCEDURE Line*(f: Display.Frame; col, X0, Y0, X1, Y1, mode: INTEGER);
- (* Draws a line from (X0, Y0) to (X1, Y1) inclusive, clipped against F. For all line points (x, y) the following holds
- always: (min(X0, X1) <= x) & (x <= max(X0, X1) & (min(Y0, Y0) <= y) & (y <= max(Y0, Y1). *)
- BEGIN
- Pictures.Line(Display.screen,f,col,X0,Y0,X1,Y1,mode)
- END Line;
- PROCEDURE Ellipse*(f: Display.Frame; col, X, Y, A, B, mode: INTEGER);
- (* Draws an ellipse with center (X, Y) and radii A and B, clipped against F. For all ellipse points (x, y) the following holds
- always: (X-A <= x) & (x < X+A) & (Y-B <= y) & (y < Y+B). When A = B the resulting ellipse has the same shape
- as the corresponding circle with R = A. *)
- BEGIN
- Pictures.Ellipse(Display.screen,f,col,X,Y,A,B,mode)
- END Ellipse;
- PROCEDURE Circle*(f: Display.Frame; col, X, Y, R, mode: INTEGER);
- (* Draws a circle with center (X, Y) and radius R, clipped against F. For all circle points (x, y) the following holds always:
- (X-R <= x) & (x < X+R) & (Y-R <= y) & (y < Y+R). *)
- BEGIN
- Pictures.Circle(Display.screen,f,col,X,Y,R,mode)
- END Circle;
- PROCEDURE Init;
- VAR image: ARRAY 17 OF SET;
- PROCEDURE Repl(step: INTEGER);
- VAR i: INTEGER;
- BEGIN i := step;
- WHILE i < 16 DO image[i+1] := image[i-step+1]; INC(i) END
- END Repl;
- BEGIN
- (*-- initialize screen patterns ---*)
- image[1] := {};
- Repl(1);
- scrPat[white] := Display.NewPattern(image, 16, 16);
- image[4] := {0, 8};
- image[3] := {};
- image[2] := {4, 12};
- image[1] := {};
- Repl(4);
- scrPat[grey1] := Display.NewPattern(image, 16, 16);
- image[2] := {0, 4, 8, 12};
- image[1] := {2, 6, 10, 14};
- Repl(2);
- scrPat[grey2] := Display.NewPattern(image, 16, 16);
- image[1] := {0, 2, 4, 6, 8, 10, 12, 14};
- image[0] := {1, 3, 5, 7, 9, 11, 13, 15};
- Repl(2);
- scrPat[grey3] := Display.NewPattern(image, 16, 16);
- image[2] := {1..3, 5..7, 9..11, 13..15};
- image[1] := {0, 1, 3..5, 7..9, 11..13, 15};
- Repl(2);
- scrPat[grey4] := Display.NewPattern(image, 16, 16);
- image[1] := {0..15};
- Repl(1);
- scrPat[black] := Display.NewPattern(image, 16, 16);
- image[4] :={3, 7, 11, 15};
- image[3] :={2, 6, 10, 14};
- image[2] :={1, 5, 9, 13};
- image[1] :={0, 4, 8, 12};
- Repl(4);
- scrPat[texture0] := Display.NewPattern(image, 16, 16);
- image[4] :={0, 4, 8, 12};
- image[3] :={1, 5, 9, 13};
- image[2] :={2, 6, 10, 14};
- image[1] :={3, 7, 11, 15};
- Repl(4);
- scrPat[texture1] := Display.NewPattern(image, 16, 16);
- image[1] := {2, 6, 10, 14};
- Repl(1);
- scrPat[texture2] := Display.NewPattern(image, 16, 16);
- image[4] := {};
- image[3] := {};
- image[2] := {};
- image[1] := {0..15};
- Repl(4);
- scrPat[texture3] := Display.NewPattern(image, 16, 16)
- END Init;
- BEGIN
- Init
- END Display1.
-